home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / win.tcl < prev   
Encoding:
Text File  |  1997-12-14  |  12.2 KB  |  506 lines  |  [TEXT/ALFA]
  1. #== (nowrap) =================================================================
  2. #    Window handling routines. All procs are bound in AlphaBits.tcl.
  3. #=============================================================================
  4.  
  5. proc shrinkHigh {} {
  6.     global tileTop tileWidth
  7.     set text [getGeometry]
  8.     set left [lindex $text 0]
  9.     set top [lindex $text 1]
  10.     sizeWin $tileWidth 160
  11.     moveWin $left $tileTop
  12. }
  13.  
  14. proc shrinkLow {} {
  15.     global tileHeight tileWidth tileLeft tileTop
  16.     sizeWin $tileWidth 160
  17.     moveWin $tileLeft [expr $tileTop + $tileHeight - 160]
  18. }
  19.  
  20. proc singlePage {} {shrinkFull}
  21.  
  22. proc shrinkFull {} {
  23.     global tileTop tileHeight tileLeft defWidth
  24.     moveWin $tileLeft $tileTop
  25.     sizeWin $defWidth $tileHeight
  26. }
  27.  
  28. proc shrinkLeft {} {
  29.     global tileWidth tileTop tileHeight tileLeft
  30.     
  31.     set margin 4
  32.     set width [expr ($tileWidth/2)-$margin]
  33.     set text [getGeometry]
  34.     set width [expr ($tileWidth/2)-$margin]
  35.     set width [expr $width + $margin / 2]
  36.     moveWin $tileLeft $tileTop
  37.     sizeWin $width $tileHeight
  38. }
  39.  
  40. proc shrinkRight {} {
  41.     global tileWidth tileTop tileHeight tileLeft
  42.     
  43.     set margin 4
  44.     set width [expr ($tileWidth/2)-$margin]
  45.     set text [getGeometry]
  46.     set width [expr ($tileWidth/2)-$margin]
  47.     set width [expr $width + $margin / 2]
  48.     moveWin [expr $tileLeft + $width + $margin] $tileTop
  49.     sizeWin $width $tileHeight
  50. }
  51.  
  52. proc swapWithNext {} {
  53.     set files [winNames -f]
  54.     if {[llength $files] < 2} return
  55.     bringToFront [lindex $files 1]
  56. }
  57.     
  58.  
  59.  
  60. proc nextWindow {} {
  61.     global win::Active 
  62.     set files [winNames -f]
  63.     if {[llength $files] < 2} {return}
  64.     set f [lindex $files 0]
  65.     regsub -all {[][]} $f {\\\0} f
  66.     set aind [lsearch -exact ${win::Active} $f]
  67.     if {$aind < 0} {error "No win '$f'"}
  68.     set rng [lrange ${win::Active} 0 [expr $aind-1]]
  69.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  70.     set win::Active [lrange ${win::Active} 1 end]
  71.     lappend win::Active $f
  72.     regsub -all {\\([][])} [lindex ${win::Active} 0] {\1} w
  73.     bringToFront $w
  74. }
  75.  
  76.  
  77. proc prevWindow {} {
  78.     global win::Active 
  79.     set files [winNames -f]
  80.     if {[llength $files] < 2} {return}
  81.     set f [lindex $files 0]
  82.     regsub -all {[][]} $f {\\\0} f
  83.     set aind [lsearch -exact ${win::Active} $f]
  84.     if {$aind < 0} {error "No win '$f'"}
  85.     set rng [lrange ${win::Active} 0 [expr $aind-1]]
  86.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  87.     set f2 [lindex [lrange ${win::Active} end end] 0]
  88.     set win::Active [lreplace ${win::Active} end end]
  89.     set win::Active [linsert ${win::Active} 0 $f2]
  90.     regsub -all {\\([][])} $f2 {\1} f2
  91.     bringToFront $f2
  92. }
  93.  
  94. proc bufferOtherWindow {} {
  95.     global tileHeight tileTop tileWidth tileMargin
  96.     global numWinsToTile
  97.     set margin $tileMargin
  98.     set win [win::Current]
  99.     set numWins 2
  100.     set hor 2
  101.     set height [expr ($tileHeight/$numWins)-$margin]
  102.     set height [expr $height + $margin / $numWins]
  103.     set width $tileWidth
  104.     set ver $tileTop
  105.     
  106.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  107.     set next [nextWin]
  108.     set res [statusPrompt "Window other half ($next): " winComp]
  109.     if {![string length $res]} {
  110.         set res $next
  111.     }
  112.     
  113.     set geo [getGeometry]
  114.     if {([lindex $geo 2] != $width) || ([lindex $geo 3] != $height) || ([lindex $geo 0] != $hor) || (([lindex $geo 1] != $ver) && ([lindex $geo 1] != [expr $ver + $height + $margin]))} {
  115.         moveWin $win 1000 0
  116.         sizeWin $win $width $height
  117.         moveWin $win $hor $ver
  118.         incr ver [expr $height + $margin]
  119.     } else {
  120.         if {[lindex $geo 1] == $ver} {
  121.             incr ver [expr $height + $margin]
  122.         } 
  123.     }
  124.     
  125.     set geo [getGeometry $res]
  126.     if {([lindex $geo 0] != $hor) || ([lindex $geo 1] != $ver) || ([lindex $geo 2] != $width) || ([lindex $geo 3] != $height)} {
  127.         moveWin $res 1000 0
  128.         sizeWin $res $width $height
  129.         moveWin $res $hor $ver
  130.     }
  131.     bringToFront $res
  132. }
  133.  
  134.         
  135.     
  136.         
  137.  
  138. proc winvertically {} {
  139.     global tileHeight tileTop tileWidth tileMargin
  140.     global numWinsToTile
  141.     set margin $tileMargin
  142.     set names [winNames -f]
  143.     set numWins [llength $names]
  144.     if ($numWins<=1) return
  145.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  146.     set height [expr ($tileHeight/$numWins)-$margin]
  147.     set height [expr $height + $margin / $numWins]
  148.     set width $tileWidth
  149.     set ver $tileTop
  150.     if {$numWins == 0} {return}
  151.  
  152.     for {set i 0} {$i < $numWins} {incr i} {
  153.         moveWin [lindex $names $i] 1000 0
  154.         sizeWin [lindex $names $i] $width $height
  155.     }
  156.  
  157.     for {set i 0} {$i < $numWins} {incr i} {
  158.         moveWin [lindex $names $i] 2 $ver
  159.         set ver [expr $ver+$margin+$height]
  160.     }
  161. }
  162.  
  163. proc winhorizontally {} {
  164.     global tileHeight tileWidth tileTop numWinsToTile horMargin
  165.  
  166.     set names [winNames -f]
  167.     set numWins [llength $names]
  168.     if ($numWins<=1) return
  169.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  170.     set width [expr ($tileWidth/$numWins)-$horMargin]
  171.     set width [expr $width + $horMargin / $numWins]
  172.     set height $tileHeight
  173.     set hor 2
  174.     if {$numWins == 0} {return}
  175.  
  176.     for {set i 0} {$i < $numWins} {incr i} {
  177.         moveWin [lindex $names $i] 1000 0
  178.         sizeWin [lindex $names $i] $width $height
  179.     }
  180.  
  181.     for {set i 0} {$i < $numWins} {incr i} {
  182.         moveWin [lindex $names $i] $hor $tileTop
  183.         set hor [expr $hor+$width+$horMargin]
  184.     }
  185. }
  186.  
  187.  
  188. proc winunequalHor {} {
  189.     global tileLeft tileHeight tileWidth tileTop numWinsToTile horMargin tileProportion
  190.     set names [winNames -f]
  191.  
  192.     moveWin [car $names] 1000 0
  193.     sizeWin [car $names] [expr $tileProportion*$tileWidth - $horMargin] $tileHeight
  194.     moveWin [car $names] $tileLeft $tileTop
  195.  
  196.     moveWin [cadr $names] 1000 0
  197.     sizeWin [cadr $names] [expr (1-$tileProportion)*$tileWidth - $horMargin] $tileHeight
  198.     moveWin [cadr $names] [expr $tileLeft + $tileProportion*$tileWidth] $tileTop
  199. }
  200.  
  201.  
  202. proc winunequalVert {} {
  203.     global tileLeft tileMargin tileHeight tileWidth tileTop numWinsToTile horMargin tileProportion
  204.     set names [winNames -f]
  205.     set height [expr $tileHeight + $tileMargin]
  206.     
  207.     moveWin [car $names] 1000 0
  208.     sizeWin [car $names] $tileWidth [expr $tileProportion*$height - $tileMargin]
  209.     moveWin [car $names] $tileLeft $tileTop
  210.  
  211.     moveWin [cadr $names] 1000 0
  212.     sizeWin [cadr $names] $tileWidth [expr (1-$tileProportion)*$height - $tileMargin]
  213.     moveWin [cadr $names] $tileLeft [expr $tileTop + $tileProportion*$height]
  214. }
  215.  
  216.  
  217. proc wintiled {} {
  218.     global tileHeight tileWidth numWinsToTile tileTop
  219.     set xPan 8
  220.     set yPan 10
  221.     set xMarg 2
  222.     set yMarg $tileTop
  223.     set yMax 50
  224.     set names [winNames -f]
  225.     set numWins [llength $names]
  226.     if ($numWins<1) return
  227.     set line 0    
  228.     set height [expr $tileHeight-$yPan*($numWins-1)]
  229.     set width [expr $tileWidth-$xPan*($numWins-1)]
  230.     
  231.     for {set i 0} {$i < $numWins} {incr i} {
  232.         moveWin [lindex $names $i] [expr $xMarg+$i*$xPan] [expr $yMarg+$line]
  233.         set line [expr $line+$yPan]
  234.         if ($line>$yMax) {set line 0}
  235.         sizeWin [lindex $names $i] $width $height
  236.     }
  237. }
  238.  
  239.  
  240. proc winoverlay {} {
  241.     global defHeight defWidth numWinsToTile tileTop
  242.     set names [winNames -f]
  243.     set numWins [llength $names]
  244.     if ($numWins<1) return
  245.     for {set i 0} {$i < $numWins} {incr i} {
  246.         moveWin [lindex $names $i] 2 $tileTop
  247.         sizeWin [lindex $names $i] $defWidth $defHeight
  248.     }
  249. }
  250.  
  251.  
  252. proc chooseAWindow {} {
  253.     set name [listpick [lsort -ignore [winNames]]]
  254.     if {[string length $name]} {
  255.         bringToFront $name
  256.         if [icon -q] { icon -f $name -o }
  257.        }
  258. }
  259.  
  260.  
  261. proc nextWin {} {
  262.     global win::Active 
  263.     set files [winNames -f]
  264.     if {[llength $files] < 2} {return ""}
  265.     set f [lindex $files 0]
  266.     set aind [lsearch ${win::Active} $f]
  267.     if {$aind < 0} {error "No win '$f'"}
  268.     if {[incr aind] < [llength ${win::Active}]} {
  269.         return [file tail [lindex ${win::Active} $aind]]
  270.     } else {
  271.         return [file tail [lindex ${win::Active} 0]]
  272.     }
  273. }
  274.  
  275. proc winComp {curr c} {
  276.     if {$c != "\t"} {return $c}
  277.     
  278.     set matches {}
  279.     foreach w [winNames] {
  280.         if {[string match "$curr*" $w]} {
  281.             lappend matches $w
  282.         }
  283.     }
  284.     if {![llength $matches]} {
  285.         beep
  286.     } else {
  287.         return [string range [largestPrefix $matches] [string length $curr] end]
  288.     }
  289.     return ""
  290. }
  291.  
  292. proc killWindowStatus {} {
  293.     if {![llength [winNames]]} return
  294.     
  295.     set def [win::CurrentTail]
  296.     set res [statusPrompt "Kill window ($def): " winComp]
  297.  
  298.     if {[string length $res]} {
  299.         catch {bringToFront $res; killWindow}
  300.     } else {killWindow}
  301. }
  302.  
  303. proc chooseWindowStatus {} {
  304.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  305.     set next [nextWin]
  306.     set res [statusPrompt "Window ($next): " winComp]
  307.     if {[string length $res]} {
  308.         catch {bringToFront $res}
  309.     } else {
  310.         catch {bringToFront $next}
  311.     }
  312. }
  313.  
  314. proc iconify {} { 
  315.     icon -t 
  316.     if {[icon -q]} {
  317.         nextWindow
  318.     }
  319. }
  320.  
  321. proc zoom {} {
  322.     global nzmState tileHeight tileWidth zoomedGeo tileTop tileLeft
  323.     
  324.     set win [win::Current]
  325.     if {[info exists nzmState($win)]} {
  326.         if {[getGeometry] == $zoomedGeo} {
  327.             set state $nzmState($win)
  328.             moveWin [lindex $state 0] [lindex $state 1]
  329.             sizeWin [lindex $state 2] [lindex $state 3]
  330.             unset nzmState($win)
  331.             return
  332.         }
  333.     } 
  334.  
  335.     set nzmState($win) [getGeometry]
  336.     moveWin $tileLeft $tileTop
  337.     sizeWin $tileWidth $tileHeight
  338.  
  339.     if {![info exists zoomedGeo]} {
  340.         set zoomedGeo [getGeometry]
  341.     }
  342. }
  343.  
  344. #================================================================================
  345.  
  346. proc otherThing {} {
  347.     set win [win::Current]
  348.     getWinInfo -w $win arr
  349.     if {$arr(split)} {
  350.         otherPane
  351.     } else {
  352.         swapWithNext
  353.     }
  354. }
  355.  
  356. proc winAttribute {att {win {}}} {
  357.     if {![string length $win]} {
  358.         set win [win::Current]
  359.     }
  360.     getWinInfo -w $win arr
  361.     return $arr($att)
  362. }
  363.  
  364. # Thanks to Johan Linde:
  365. proc refresh {{w ""}} {
  366.     if {$w == ""} {
  367.         eval sizeWin [lrange [getGeometry] 2 end]
  368.     } else {
  369.         eval sizeWin [list $w] [lrange [getGeometry $w] 2 end]
  370.     }
  371. }
  372. proc floatName {str} {
  373.     if {[string match "•*" $str]} {
  374.         foreach n [info globals {*Menu}] {
  375.             global $n
  376.             if {![catch {set $n}] && ([set $n] == $str)} {
  377.                 regexp {(.*)Menu} $n dummy name
  378.                 return "[string toup [string index $name 0]][string range $name 1 end]"
  379.             }
  380.         }
  381.     }
  382.     return "[string toup [string index $str 0]][string range $str 1 end]"
  383. }
  384. proc winDirty {} {
  385.     getWinInfo arr
  386.     return $arr(dirty)
  387. }
  388.  
  389. proc winReadOnly {{win ""}} {
  390.     goto 0
  391.     if {$win == ""} {set win [win::Current]}
  392.     setWinInfo -w $win dirty 0
  393.     setWinInfo -w $win read-only 1
  394. }
  395.  
  396. proc stripNameCount str {
  397.     regsub { <\d+>} $str {} str
  398.     return $str
  399. }
  400.  
  401. proc shrinkWindow {{shrinkWidth 0}} {
  402.     global defHeight defWidth
  403.     # These constants work for 9-pt Monaco type
  404.     set lineht 11
  405.     set htoff 22
  406.     set chwd 6
  407.     set choff 20
  408.     
  409.     set wd [lindex [getGeometry] 2]
  410.     set ht [lindex [getGeometry] 3]
  411.     set top [lindex [getGeometry] 1]
  412.     set left [lindex [getGeometry] 0]
  413.     
  414.     set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
  415.     set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
  416.     set mnht 120
  417.     set mnwd 200
  418.  
  419.     set htWd [fileHtWd $shrinkWidth]
  420.     set lines [lindex $htWd 0]
  421.     set chars [lindex $htWd 1]
  422.  
  423.     if {$lines <= 1} {set lines 10}
  424.     
  425.     
  426.     if {$lines > 0} {
  427.         set ht [expr $htoff + ( $lineht * (1 + $lines)) ]
  428.     } elseif {$ht > $defHeight} {
  429.         set ht $defHeight
  430.     }
  431.     
  432.     if {$chars > 0} {
  433.         set wd [expr $choff + ( $chwd * (2 + $chars)) ]
  434.     } elseif {$wd > $defWidth} {
  435.         set wd $defWidth
  436.     }
  437.     
  438.     if {$ht > $mxht} {set ht $mxht}
  439.     if {$wd > $mxwd} {set wd $mxwd}
  440.     if {$ht < $mnht} {set ht $mnht}
  441.     if {$wd < $mnwd} {set wd $mnwd}
  442.     sizeWin $wd $ht
  443. }
  444.  
  445. #############################################################################
  446. # Return the number of lines and the maximum number of characters in any 
  447. # line of a file.  It would be nice if there was a built-in command to
  448. # do this (i.e., compiled C code) because this is a pretty slow way to
  449. # get the maximum line width.
  450.  
  451. proc fileHtWd {{checkWidth 0}} {
  452.     set text [getText 0 [maxPos]] 
  453.     getWinInfo arr
  454.     set tabw [expr $arr(tabsize) - 1]
  455.     
  456.     set lines [split $text "\r"]
  457.     set nlines [llength $lines]
  458.  
  459.     if {$checkWidth > 1} {
  460.         set lines [eval lrange \$lines [displayedLines]]
  461.     }
  462.     
  463.     set llen 0
  464.     if {$checkWidth > 0} {
  465.         foreach line $lines {
  466.             regsub {                +∞.*$} $line {} line
  467.             regsub {    } $line {    } line
  468.             set len [string length $line]
  469.             if {[set ntab [llength [split $line "\t"]]] > 1} {
  470.                 set len [expr $len + $tabw*($ntab-1)]
  471.             }
  472.             if { $len > $llen} {
  473.                 set llen $len
  474.             }
  475.         }
  476.     }
  477. #    alertnote "Text Height : $nlines ; Text Width : $llen "
  478.     return [list $nlines $llen]
  479. }
  480.  
  481. # Report what range of lines are displayed in any window.
  482. # (A side effect is that the insertion point is moved to the 
  483. # top of the window, if it was previously off-screen)
  484. #
  485. proc displayedLines {{window {}}} {
  486.     if {$window == {}} { set window [win::Current] }
  487.  
  488.     bringToFront $window
  489.     set oldPos [getPos]
  490.     moveInsertionHere
  491.     set top [getPos]
  492.     set first [lindex [posToRowCol $top] 0]
  493.     moveInsertionHere -last
  494.     set bottom [getPos]
  495.     set last [lindex [posToRowCol $bottom] 0]
  496.  
  497.     if {$oldPos < $top || $oldPos > $bottom} {
  498.         goto $top
  499.     } else {
  500.         goto $oldPos
  501.     }
  502.  
  503.     return [list $first $last]
  504. }
  505.  
  506.